home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / TUT2NEW.ZIP / TUT2.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-29  |  12KB  |  357 lines

  1. (*****************************************************************************)
  2. (*                                                                           *)
  3. (* TUTPROG2.PAS - VGA Trainer Program 2 (in Pascal)                          *)
  4. (*                                                                           *)
  5. (* "The VGA Trainer Program" is written by Denthor of Asphyxia.  However it  *)
  6. (* was limited to Pascal only in its first run.  All I have done is taken    *)
  7. (* his original release, translated it to C++, and touched up a few things.  *)
  8. (* I take absolutely no credit for the concepts presented in this code, and  *)
  9. (* am NOT the person to ask for help if you are having trouble.              *)
  10. (*                                                                           *)
  11. (* Program Notes : This program presents many new concepts, including:       *)
  12. (*                 line drawing, pallette manipulation, and fading.          *)
  13. (*                 the computer into graphics mode, testing out two differ-  *)
  14. (*                 ent methods of putting pixels to the screen, and finally  *)
  15. (*                 re-entering text mode.                                    *)
  16. (*                                                                           *)
  17. (* Author        : Grant Smith (Denthor)  - denthor@beastie.cs.und.ac.za     *)
  18. (*                                                                           *)
  19. (*****************************************************************************)
  20.  
  21. {$X+}
  22.  
  23. Uses Crt;
  24.  
  25. CONST VGA=$a000;
  26.  
  27. Var Pall,Pall2 : Array[0..255,1..3] of Byte;
  28.      { This declares the PALL variable. 0 to 255 signify the colors of the
  29.        pallette, 1 to 3 signifies the Red, Green and Blue values. I am
  30.        going to use this as a sort of "virtual pallette", and alter it
  31.        as much as I want, then suddenly bang it to screen. Pall2 is used
  32.        to "remember" the origional pallette so that we can restore it at
  33.        the end of the program. }
  34.  
  35.  
  36.  
  37. {──────────────────────────────────────────────────────────────────────────}
  38. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  39. BEGIN
  40.   asm
  41.      mov        ax,0013h
  42.      int        10h
  43.   end;
  44. END;
  45.  
  46.  
  47. {──────────────────────────────────────────────────────────────────────────}
  48. Procedure SetText;  { This procedure returns you to text mode.  }
  49. BEGIN
  50.   asm
  51.      mov        ax,0003h
  52.      int        10h
  53.   end;
  54. END;
  55.  
  56.  
  57. {──────────────────────────────────────────────────────────────────────────}
  58. procedure WaitRetrace; assembler;
  59.   { This waits until you are in a Verticle Retrace ... this means that all
  60.     screen manipulation you do only appears on screen in the next verticle
  61.     retrace ... this removes most of the "fuzz" that you see on the screen
  62.     when changing the pallette. It unfortunately slows down your program
  63.     by "synching" your program with your monitor card ... it does mean
  64.     that the program will run at almost the same speed on different
  65.     speeds of computers which have similar monitors. In our SilkyDemo,
  66.     we used a WaitRetrace, and it therefore runs at the same (fairly
  67.     fast) speed when Turbo is on or off. }
  68.  
  69. label
  70.   l1, l2;
  71. asm
  72.     mov dx,3DAh
  73. l1:
  74.     in al,dx
  75.     and al,08h
  76.     jnz l1
  77. l2:
  78.     in al,dx
  79.     and al,08h
  80.     jz  l2
  81. end;
  82.  
  83.  
  84. {──────────────────────────────────────────────────────────────────────────}
  85. Procedure GetPal(ColorNo : Byte; Var R,G,B : Byte);
  86.   { This reads the values of the Red, Green and Blue values of a certain
  87.     color and returns them to you. }
  88. Begin
  89.    Port[$3c7] := ColorNo;
  90.    R := Port[$3c9];
  91.    G := Port[$3c9];
  92.    B := Port[$3c9];
  93. End;
  94.  
  95.  
  96. {──────────────────────────────────────────────────────────────────────────}
  97. Procedure Pal(ColorNo : Byte; R,G,B : Byte);
  98.   { This sets the Red, Green and Blue values of a certain color }
  99. Begin
  100.    Port[$3c8] := ColorNo;
  101.    Port[$3c9] := R;
  102.    Port[$3c9] := G;
  103.    Port[$3c9] := B;
  104. End;
  105.  
  106.  
  107. {──────────────────────────────────────────────────────────────────────────}
  108. Procedure Putpixel (X,Y : Integer; Col : Byte);
  109.   { This puts a pixel on the screen by writing directly to memory. }
  110. BEGIN
  111.   Mem [VGA:X+(Y*320)]:=Col;
  112. END;
  113.  
  114.  
  115. {──────────────────────────────────────────────────────────────────────────}
  116. Procedure line(a,b,c,d,col:integer);
  117.   { This draws a line from a,b to c,d of color col. }
  118.    Function sgn(a:real):integer;
  119.    BEGIN
  120.         if a>0 then sgn:=+1;
  121.         if a<0 then sgn:=-1;
  122.         if a=0 then sgn:=0;
  123.    END;
  124. var u,s,v,d1x,d1y,d2x,d2y,m,n:real;
  125.     i:integer;
  126. BEGIN
  127.      u:= c - a;
  128.      v:= d - b;
  129.      d1x:= SGN(u);
  130.      d1y:= SGN(v);
  131.      d2x:= SGN(u);
  132.      d2y:= 0;
  133.      m:= ABS(u);
  134.      n := ABS(v);
  135.      IF NOT (M>N) then
  136.      BEGIN
  137.           d2x := 0 ;
  138.           d2y := SGN(v);
  139.           m := ABS(v);
  140.           n := ABS(u);
  141.      END;
  142.      s := INT(m / 2);
  143.      FOR i := 0 TO round(m) DO
  144.      BEGIN
  145.           putpixel(a,b,col);
  146.           s := s + n;
  147.           IF not (s<m) THEN
  148.           BEGIN
  149.                s := s - m;
  150.                a:= a +round(d1x);
  151.                b := b + round(d1y);
  152.           END
  153.           ELSE
  154.           BEGIN
  155.                a := a + round(d2x);
  156.                b := b + round(d2y);
  157.           END;
  158.      END;
  159. END;
  160.  
  161.  
  162. {──────────────────────────────────────────────────────────────────────────}
  163. Procedure PalPlay;
  164.   { This procedure mucks about with our "virtual pallette", then shoves it
  165.     to screen. }
  166. Var Tmp : Array[1..3] of Byte;
  167.   { This is used as a "temporary color" in our pallette }
  168.     loop1 : Integer;
  169. BEGIN
  170.    Move(Pall[200],Tmp,3);
  171.      { This copies color 200 from our virtual pallette to the Tmp variable }
  172.    Move(Pall[0],Pall[1],200*3);
  173.      { This moves the entire virtual pallette up one color }
  174.    Move(Tmp,Pall[0],3);
  175.      { This copies the Tmp variable to the bottom of the virtual pallette }
  176.    WaitRetrace;
  177.    For loop1:=1 to 255 do
  178.      pal (loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);
  179. END;
  180.  
  181.  
  182. {──────────────────────────────────────────────────────────────────────────}
  183. Procedure SetUpScreen;
  184.   { This gets our screen ready but setting up the pallette and drawing
  185.     the lines. }
  186. Var j,Loop : Integer;
  187. BEGIN
  188.    FillChar(Pall,SizeOf(Pall),0);
  189.        { Clear the entire PALL variable to zero. }
  190.    For Loop := 0 to 31 do BEGIN
  191.       Pall[Loop,1] := (Loop mod 64) + 32; END;
  192.    j := 63;
  193.    For Loop := 32 to 63 do BEGIN
  194.       Pall[Loop,1] := j; dec(j); END;
  195.    For Loop := 64 to 127 do BEGIN
  196.       Pall[Loop,2] := Loop mod 64; END;
  197.    For Loop := 128 to 196 do BEGIN
  198.       Pall[Loop,3] := Loop mod 64;
  199.  
  200.    END;
  201.        { This sets colors 0 to 200 in the PALL variable to values between
  202.          0 to 63. the MOD function gives you the remainder of a division,
  203.          ie. 105 mod 10 = 5 }
  204.  
  205.    For Loop := 1 to 320 do BEGIN
  206.       Line(320-Loop,199,320-Loop,0,(Loop Mod 201)+1);
  207.        { These two lines start drawing lines from the left and the right
  208.          hand sides of the screen, using colors 1 to 199. Look at these
  209.          two lines and understand them. }
  210.       PalPlay;
  211.         { This calls the PalPlay procedure }
  212.    END;
  213. END;
  214.  
  215.  
  216. {──────────────────────────────────────────────────────────────────────────}
  217. Procedure GrabPallette;
  218. VAR loop1:integer;
  219. BEGIN
  220.   For loop1:=0 to 255 do
  221.     Getpal (loop1,pall2[loop1,1],pall2[loop1,2],pall2[loop1,3]);
  222. END;
  223.  
  224.  
  225.  
  226. {──────────────────────────────────────────────────────────────────────────}
  227. Procedure Blackout;
  228.   { This procedure blackens the screen by setting the pallette values of
  229.     all the colors to zero. }
  230. VAR loop1:integer;
  231. BEGIN
  232.   WaitRetrace;
  233.   For loop1:=0 to 255 do
  234.     Pal (loop1,0,0,0);
  235. END;
  236.  
  237.  
  238. {──────────────────────────────────────────────────────────────────────────}
  239. Procedure HiddenScreenSetup;
  240.   { This procedure sets up the screen while it is blacked out, so that the
  241.     user can't see what is happening. }
  242. VAR loop1,loop2:integer;
  243. BEGIN
  244.   For loop1:=0 to 319 do
  245.     For loop2:=0 to 199 do
  246.       PutPixel (loop1,loop2,Random (256));
  247. END;
  248.  
  249.  
  250. {──────────────────────────────────────────────────────────────────────────}
  251. Procedure Fadeup;
  252.   { This procedure slowly fades up the new screen }
  253. VAR loop1,loop2:integer;
  254.     Tmp : Array [1..3] of byte;
  255.       { This is temporary storage for the values of a color }
  256. BEGIN
  257.   For loop1:=1 to 64 do BEGIN
  258.       { A color value for Red, green or blue is 0 to 63, so this loop only
  259.         need be executed a maximum of 64 times }
  260.     WaitRetrace;
  261.     For loop2:=0 to 255 do BEGIN
  262.       Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
  263.       If Tmp[1]<Pall2[loop2,1] then inc (Tmp[1]);
  264.       If Tmp[2]<Pall2[loop2,2] then inc (Tmp[2]);
  265.       If Tmp[3]<Pall2[loop2,3] then inc (Tmp[3]);
  266.         { If the Red, Green or Blue values of color loop2 are less then they
  267.           should be, increase them by one. }
  268.       Pal (loop2,Tmp[1],Tmp[2],Tmp[3]);
  269.         { Set the new, altered pallette color. }
  270.     END;
  271.   END;
  272. END;
  273.  
  274.  
  275. {──────────────────────────────────────────────────────────────────────────}
  276. Procedure FadeDown;
  277.   { This procedure fades the screen out to black. }
  278. VAR loop1,loop2:integer;
  279.     Tmp : Array [1..3] of byte;
  280.       { This is temporary storage for the values of a color }
  281. BEGIN
  282.   For loop1:=1 to 64 do BEGIN
  283.     WaitRetrace;
  284.     For loop2:=0 to 255 do BEGIN
  285.       Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
  286.       If Tmp[1]>0 then dec (Tmp[1]);
  287.       If Tmp[2]>0 then dec (Tmp[2]);
  288.       If Tmp[3]>0 then dec (Tmp[3]);
  289.         { If the Red, Green or Blue values of color loop2 are not yet zero,
  290.           then, decrease them by one. }
  291.       Pal (loop2,Tmp[1],Tmp[2],Tmp[3]);
  292.         { Set the new, altered pallette color. }
  293.     END;
  294.   END;
  295. END;
  296.  
  297.  
  298. {──────────────────────────────────────────────────────────────────────────}
  299. Procedure RestorePallette;
  300.   { This procedure restores the origional pallette }
  301. VAR loop1:integer;
  302. BEGIN
  303.   WaitRetrace;
  304.   For loop1:=0 to 255 do
  305.     pal (loop1,Pall2[loop1,1],Pall2[loop1,2],Pall2[loop1,3]);
  306. END;
  307.  
  308.  
  309. BEGIN
  310.   ClrScr;
  311.   Writeln ('This program will draw lines of different colors across the');
  312.   Writeln ('screen and change them only by changing their pallette values.');
  313.   Writeln ('The nice thing about using the pallette is that one pallette');
  314.   Writeln ('change changes the same color over the whole screen, without');
  315.   Writeln ('you having to redraw it. Because I am using a WaitRetrace');
  316.   Writeln ('command, turning on and off your turbo during the demonstration');
  317.   Writeln ('should have no effect.');
  318.   Writeln;
  319.   Writeln ('The second part of the demo blacks out the screen using the');
  320.   Writeln ('pallette, fades in the screen, waits for a keypress, then fades');
  321.   Writeln ('it out again. I haven''t put in any delays for the fadein/out,');
  322.   Writeln ('so you will have to put ''em in yourself to get it to the speed you');
  323.   Writeln ('like. Have fun and enjoy! ;-)');
  324.   Writeln; Writeln;
  325.   Writeln ('Hit any key to continue ...');
  326.   Readkey;
  327.   SetMCGA;
  328.   GrabPallette;
  329.   SetUpScreen;
  330.   repeat
  331.      PalPlay;
  332.        { Call the PalPlay procedure repeatedly until a key is pressed. }
  333.   Until Keypressed;
  334.   Readkey;
  335.     { Read in the key pressed otherwise it is left in the keyboard buffer }
  336.   Blackout;
  337.   HiddenScreenSetup;
  338. {  FadeUp;
  339.   Readkey;
  340.   FadeDown;
  341.   Readkey;}
  342.   RestorePallette;
  343.   SetText;
  344.   Writeln ('All done. This concludes the second sample program in the ASPHYXIA');
  345.   Writeln ('Training series. You may reach DENTHOR under the name of GRANT');
  346.   Writeln ('SMITH on the MailBox BBS, or leave a message to ASPHYXIA on the');
  347.   Writeln ('ASPHYXIA BBS. Get the numbers from Roblist, or write to :');
  348.   Writeln ('             Grant Smith');
  349.   Writeln ('             P.O. Box 270');
  350.   Writeln ('             Kloof');
  351.   Writeln ('             3640');
  352.   Writeln ('I hope to hear from you soon!');
  353.   Writeln; Writeln;
  354.   Write   ('Hit any key to exit ...');
  355.   Readkey;
  356. END.
  357.